home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / os2 / e33el2.zip / emacs / 19.33 / lisp / skeleton.el < prev    next >
Lisp/Scheme  |  1996-07-02  |  23KB  |  584 lines
  1. ;;; skeleton.el --- Lisp language extension for writing statement skeletons
  2.  
  3. ;; Copyright (C) 1993, 1994, 1995, 1996 by Free Software Foundation, Inc.
  4.  
  5. ;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389
  6. ;; Maintainer: FSF
  7. ;; Keywords: extensions, abbrev, languages, tools
  8.  
  9. ;; This file is part of GNU Emacs.
  10.  
  11. ;; GNU Emacs is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; GNU Emacs is distributed in the hope that it will be useful,
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. ;; GNU General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24. ;; Boston, MA 02111-1307, USA.
  25.  
  26. ;;; Commentary:
  27.  
  28. ;; A very concise language extension for writing structured statement
  29. ;; skeleton insertion commands for programming language modes.  This
  30. ;; originated in shell-script mode and was applied to ada-mode's
  31. ;; commands which shrunk to one third.  And these commands are now
  32. ;; user configurable.
  33.  
  34. ;;; Code:
  35.  
  36. ;; page 1:    statement skeleton language definition & interpreter
  37. ;; page 2:    paired insertion
  38. ;; page 3:    mirror-mode, an example for setting up paired insertion
  39.  
  40.  
  41. (defvar skeleton-transformation nil
  42.   "*If non-nil, function applied to literal strings before they are inserted.
  43. It should take strings and characters and return them transformed, or nil
  44. which means no transformation.
  45. Typical examples might be `upcase' or `capitalize'.")
  46.  
  47. ; this should be a fourth argument to defvar
  48. (put 'skeleton-transformation 'variable-interactive
  49.      "aTransformation function: ")
  50.  
  51.  
  52. (defvar skeleton-autowrap t
  53.   "Controls wrapping behaviour of functions created with `define-skeleton'.
  54. When the region is visible (due to `transient-mark-mode' or marking a region
  55. with the mouse) and this is non-`nil' and the function was called without an
  56. explicit ARG, then the ARG defaults to -1, i.e. wrapping around the visible
  57. region.
  58.  
  59. We will probably delete this variable in a future Emacs version
  60. unless we get a substantial number of complaints about the auto-wrap
  61. feature.")
  62.  
  63. (defvar skeleton-end-hook
  64.   (lambda ()
  65.     (or (eolp) (newline-and-indent)))
  66.   "Hook called at end of skeleton but before going to point of interest.
  67. By default this moves out anything following to next line.
  68. The variables `v1' and `v2' are still set when calling this.")
  69.  
  70.  
  71. ;;;###autoload
  72. (defvar skeleton-filter 'identity
  73.   "Function for transforming a skeleton proxy's aliases' variable value.")
  74.  
  75. (defvar skeleton-untabify t
  76.   "When non-`nil' untabifies when deleting backwards with element -ARG.")
  77.  
  78. (defvar skeleton-newline-indent-rigidly nil
  79.   "When non-`nil', indent rigidly under current line for element `\\n'.
  80. Else use mode's `indent-line-function'.")
  81.  
  82. (defvar skeleton-further-elements ()
  83.   "A buffer-local varlist (see `let') of mode specific skeleton elements.
  84. These variables are bound while interpreting a skeleton.  Their value may
  85. in turn be any valid skeleton element if they are themselves to be used as
  86. skeleton elements.")
  87. (make-variable-buffer-local 'skeleton-further-elements)
  88.  
  89.  
  90. (defvar skeleton-subprompt
  91.   (substitute-command-keys
  92.    "RET, \\<minibuffer-local-map>\\[abort-recursive-edit] or \\[help-command]")
  93.   "*Replacement for %s in prompts of recursive subskeletons.")
  94.  
  95.  
  96. (defvar skeleton-abbrev-cleanup nil
  97.   "Variable used to delete the character that led to abbrev expansion.")
  98.  
  99.  
  100. (defvar skeleton-debug nil
  101.   "*If non-nil `define-skeleton' will override previous definition.")
  102.  
  103. ;; reduce the number of compiler warnings
  104. (defvar skeleton)
  105. (defvar skeleton-modified)
  106. (defvar skeleton-point)
  107. (defvar skeleton-regions)
  108.  
  109. ;;;###autoload
  110. (defmacro define-skeleton (command documentation &rest skeleton)
  111.   "Define a user-configurable COMMAND that enters a statement skeleton.
  112. DOCUMENTATION is that of the command, while the variable of the same name,
  113. which contains the skeleton, has a documentation to that effect.
  114. INTERACTOR and ELEMENT ... are as defined under `skeleton-insert'."
  115.   (if skeleton-debug
  116.       (set command skeleton))
  117.   `(progn
  118.      (defun ,command (&optional str arg)
  119.        ,(concat documentation
  120.         (if (string-match "\n\\>" documentation)
  121.             "" "\n")
  122.         "\n"
  123.   "This is a skeleton command (see `skeleton-insert').
  124. Normally the skeleton text is inserted at point, with nothing \"inside\".
  125. If there is a highlighted region, the skeleton text is wrapped
  126. around the region text.
  127.  
  128. A prefix argument ARG says to wrap the skeleton around the next ARG words.
  129. A prefix argument of zero says to wrap around zero words---that is, nothing.
  130. This is a way of overiding the use of a highlighted region.")
  131.        (interactive "*P\nP")
  132.        (skeleton-proxy-new ',skeleton str arg))))
  133.  
  134. ;;;###autoload
  135. (defun skeleton-proxy-new (skeleton &optional str arg)
  136.   "Insert skeleton defined by variable of same name (see `skeleton-insert').
  137. Prefix ARG allows wrapping around words or regions (see `skeleton-insert').
  138. If no ARG was given, but the region is visible, ARG defaults to -1 depending
  139. on `skeleton-autowrap'.  An ARG of  M-0  will prevent this just for once.
  140. This command can also be an abbrev expansion (3rd and 4th columns in
  141. \\[edit-abbrevs]  buffer: \"\"  command-name).
  142.  
  143. When called as a function, optional first argument STR may also be a string
  144. which will be the value of `str' whereas the skeleton's interactor is then
  145. ignored."
  146.   (interactive "*P\nP")
  147.   (setq skeleton (funcall skeleton-filter skeleton))
  148.   (if (not skeleton)
  149.       (if (memq this-command '(self-insert-command
  150.                    skeleton-pair-insert-maybe
  151.                    expand-abbrev))
  152.       (setq buffer-undo-list (primitive-undo 1 buffer-undo-list)))
  153.     (skeleton-insert skeleton
  154.              (if (setq skeleton-abbrev-cleanup
  155.                    (or (eq this-command 'self-insert-command)
  156.                    (eq this-command
  157.                        'skeleton-pair-insert-maybe)))
  158.              ()
  159.                ;; Pretend  C-x a e  passed its prefix arg to us
  160.                (if (or arg current-prefix-arg)
  161.                (prefix-numeric-value (or arg
  162.                              current-prefix-arg))
  163.              (and skeleton-autowrap
  164.                   (or (eq last-command 'mouse-drag-region)
  165.                   (and transient-mark-mode mark-active))
  166.                   -1)))
  167.              (if (stringp str)
  168.              str))
  169.     (and skeleton-abbrev-cleanup
  170.      (setq skeleton-abbrev-cleanup (point))
  171.      (add-hook 'post-command-hook 'skeleton-abbrev-cleanup nil t))))
  172.  
  173. ;; This command isn't meant to be called, only it's aliases with meaningful
  174. ;; names are.
  175. ;;;###autoload
  176. (defun skeleton-proxy (&optional str arg)
  177.   "Insert skeleton defined by variable of same name (see `skeleton-insert').
  178. Prefix ARG allows wrapping around words or regions (see `skeleton-insert').
  179. If no ARG was given, but the region is visible, ARG defaults to -1 depending
  180. on `skeleton-autowrap'.  An ARG of  M-0  will prevent this just for once.
  181. This command can also be an abbrev expansion (3rd and 4th columns in
  182. \\[edit-abbrevs]  buffer: \"\"  command-name).
  183.  
  184. When called as a function, optional first argument STR may also be a string
  185. which will be the value of `str' whereas the skeleton's interactor is then
  186. ignored."
  187.   (interactive "*P\nP")
  188.   (let ((function (nth 1 (backtrace-frame 1))))
  189.     (if (eq function 'nth)        ; uncompiled Lisp function
  190.     (setq function (nth 1 (backtrace-frame 5)))
  191.       (if (eq function 'byte-code)    ; tracing byte-compiled function
  192.       (setq function (nth 1 (backtrace-frame 2)))))
  193.     (if (not (setq function (funcall skeleton-filter (symbol-value function))))
  194.     (if (memq this-command '(self-insert-command
  195.                  skeleton-pair-insert-maybe
  196.                  expand-abbrev))
  197.         (setq buffer-undo-list (primitive-undo 1 buffer-undo-list)))
  198.       (skeleton-insert function
  199.                (if (setq skeleton-abbrev-cleanup
  200.                  (or (e